home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dll_gen / drvplus / filetd.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-06-06  |  16.5 KB  |  528 lines

  1. VERSION 2.00
  2. Begin Form FileTD 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "File Time/Date Changer"
  6.    ClientHeight    =   5730
  7.    ClientLeft      =   1245
  8.    ClientTop       =   1125
  9.    ClientWidth     =   6990
  10.    ControlBox      =   0   'False
  11.    Height          =   6135
  12.    Left            =   1185
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   5730
  17.    ScaleWidth      =   6990
  18.    Top             =   780
  19.    Width           =   7110
  20.    Begin CommandButton CmdDeselectAll 
  21.       BackColor       =   &H00C0C0C0&
  22.       Caption         =   "&Deselect All"
  23.       Height          =   375
  24.       Left            =   360
  25.       TabIndex        =   1
  26.       Top             =   5040
  27.       Width           =   1575
  28.    End
  29.    Begin CommandButton CmdSelectAll 
  30.       BackColor       =   &H00C0C0C0&
  31.       Caption         =   "&Select All"
  32.       Height          =   375
  33.       Left            =   360
  34.       TabIndex        =   0
  35.       Top             =   4680
  36.       Width           =   1575
  37.    End
  38.    Begin CommandButton ChgDateTime 
  39.       BackColor       =   &H00C0C0C0&
  40.       Caption         =   "Change &Both"
  41.       Height          =   375
  42.       Left            =   5040
  43.       TabIndex        =   6
  44.       Top             =   4680
  45.       Width           =   1575
  46.    End
  47.    Begin CommandButton CmdNewTime 
  48.       BackColor       =   &H00C0C0C0&
  49.       Caption         =   "New T&ime"
  50.       Height          =   375
  51.       Left            =   3480
  52.       TabIndex        =   5
  53.       Top             =   5040
  54.       Width           =   1575
  55.    End
  56.    Begin CommandButton CmdNewDate 
  57.       BackColor       =   &H00C0C0C0&
  58.       Caption         =   "New D&ate"
  59.       Height          =   375
  60.       Left            =   1920
  61.       TabIndex        =   3
  62.       Top             =   5040
  63.       Width           =   1575
  64.    End
  65.    Begin CommandButton CmdChgTime 
  66.       BackColor       =   &H00C0C0C0&
  67.       Caption         =   "Change &Time"
  68.       Height          =   375
  69.       Left            =   3480
  70.       TabIndex        =   4
  71.       Top             =   4680
  72.       Width           =   1575
  73.    End
  74.    Begin CommandButton CmdChgDate 
  75.       BackColor       =   &H00C0C0C0&
  76.       Caption         =   "Change &Date"
  77.       Height          =   375
  78.       Left            =   1920
  79.       TabIndex        =   2
  80.       Top             =   4680
  81.       Width           =   1575
  82.    End
  83.    Begin TextBox Text1 
  84.       Height          =   285
  85.       Left            =   360
  86.       MaxLength       =   11
  87.       TabIndex        =   8
  88.       Text            =   "Text1"
  89.       Top             =   1080
  90.       Width           =   3015
  91.    End
  92.    Begin FileListBox File1 
  93.       Height          =   225
  94.       Hidden          =   -1  'True
  95.       Left            =   4920
  96.       System          =   -1  'True
  97.       TabIndex        =   12
  98.       Top             =   3720
  99.       Visible         =   0   'False
  100.       Width           =   1575
  101.    End
  102.    Begin DirListBox Dir1 
  103.       Height          =   1155
  104.       Left            =   3600
  105.       TabIndex        =   9
  106.       Top             =   240
  107.       Width           =   3015
  108.    End
  109.    Begin DriveListBox Drive1 
  110.       Height          =   315
  111.       Left            =   360
  112.       TabIndex        =   10
  113.       Top             =   240
  114.       Width           =   3015
  115.    End
  116.    Begin ListBox FileList 
  117.       FontBold        =   0   'False
  118.       FontItalic      =   0   'False
  119.       FontName        =   "Fixedsys"
  120.       FontSize        =   9
  121.       FontStrikethru  =   0   'False
  122.       FontUnderline   =   0   'False
  123.       Height          =   1605
  124.       Left            =   360
  125.       MultiSelect     =   1  'Simple
  126.       Sorted          =   -1  'True
  127.       TabIndex        =   11
  128.       Top             =   2760
  129.       Width           =   6255
  130.    End
  131.    Begin CommandButton CmdOkay 
  132.       BackColor       =   &H00C0C0C0&
  133.       Cancel          =   -1  'True
  134.       Caption         =   "O &K A Y"
  135.       Height          =   375
  136.       Left            =   5040
  137.       TabIndex        =   7
  138.       Top             =   5040
  139.       Width           =   1575
  140.    End
  141.    Begin Label LblFileCount 
  142.       Alignment       =   2  'Center
  143.       BackColor       =   &H00C0C0C0&
  144.       Caption         =   "Label2"
  145.       ForeColor       =   &H00800000&
  146.       Height          =   195
  147.       Left            =   2040
  148.       TabIndex        =   17
  149.       Top             =   1920
  150.       Width           =   2895
  151.    End
  152.    Begin Label LblTime 
  153.       Alignment       =   2  'Center
  154.       BackColor       =   &H00C0C0C0&
  155.       Caption         =   "Label3"
  156.       ForeColor       =   &H00000080&
  157.       Height          =   195
  158.       Left            =   3600
  159.       TabIndex        =   16
  160.       Top             =   2400
  161.       Width           =   3015
  162.    End
  163.    Begin Label LblDate 
  164.       Alignment       =   2  'Center
  165.       BackColor       =   &H00C0C0C0&
  166.       Caption         =   "Label3"
  167.       ForeColor       =   &H00000080&
  168.       Height          =   195
  169.       Left            =   360
  170.       TabIndex        =   15
  171.       Top             =   2400
  172.       Width           =   3015
  173.    End
  174.    Begin Label LblFullPath 
  175.       Alignment       =   2  'Center
  176.       BackColor       =   &H00C0C0C0&
  177.       Caption         =   "Label2"
  178.       Height          =   195
  179.       Left            =   360
  180.       TabIndex        =   14
  181.       Top             =   1560
  182.       Width           =   6255
  183.    End
  184.    Begin Label Label1 
  185.       BackStyle       =   0  'Transparent
  186.       Caption         =   "Search Specification:"
  187.       ForeColor       =   &H00800000&
  188.       Height          =   195
  189.       Left            =   360
  190.       TabIndex        =   13
  191.       Top             =   840
  192.       Width           =   3015
  193.    End
  194. 'file list box allow multiple selections
  195. Dim PathWord As String
  196. Dim FileSpec As String
  197. Sub ChgDateTime_Click ()
  198.     ChangeCount% = 0
  199.     Screen.MousePointer = 11
  200.     On Error GoTo BadDrive4
  201.     For i = 0 To FileList.ListCount - 1
  202.         If FileList.Selected(i) = True Then
  203.             ThisDir$ = CurDir$
  204.             pos% = InStr(FileList.List(i), Chr$(9))
  205.             ThisFile$ = Left$(FileList.List(i), pos% - 1)
  206.             ThisFile$ = AddSeparator(ThisDir$) + ThisFile$
  207.             ChgYear% = Val(TheYear)
  208.             ChgMonth% = Val(TheMonth)
  209.             ChgDate% = Val(TheDate)
  210.             x% = SetFileDate(ThisFile$, ChgYear%, ChgMonth%, ChgDate%)
  211.             If x% = False Then
  212.                 Screen.MousePointer = 0
  213.                 MsgBox ThisFile$, 16, "Can Not Change Time"
  214.                 End If
  215.             ChgHours% = Val(TheHours)
  216.             ChgMinutes% = Val(TheMinutes)
  217.             x% = SetFileTime(ThisFile$, ChgHours%, ChgMinutes%)
  218.             If x% = False Then
  219.                 Screen.MousePointer = 0
  220.                 MsgBox ThisFile$, 16, "Can Not Change Time"
  221.                 End If
  222.             ChangeCount% = ChangeCount% + 1
  223.             End If
  224.         Next i
  225.     Screen.MousePointer = 0
  226.     If ChangeCount% = 0 Then
  227.         MsgBox "No files selected to change!", 16, "File Change Error"
  228.         Exit Sub
  229.         Else
  230.         DoFileList
  231.         End If
  232.     Exit Sub
  233. BadDrive4:
  234.     Screen.MousePointer = 0
  235.     MsgBox "Can NOT access drive!", 16, "Drive Error"
  236.     Exit Sub
  237. End Sub
  238. Sub CmdChgDate_Click ()
  239.     ChangeCount% = 0
  240.     Screen.MousePointer = 11
  241.     On Error GoTo BadDrive
  242.     For i = 0 To FileList.ListCount - 1
  243.         If FileList.Selected(i) = True Then
  244.             ThisDir$ = CurDir$
  245.             pos% = InStr(FileList.List(i), Chr$(9))
  246.             ThisFile$ = Left$(FileList.List(i), pos% - 1)
  247.             ThisFile$ = AddSeparator(ThisDir$) + ThisFile$
  248.             ChgYear% = Val(TheYear)
  249.             ChgMonth% = Val(TheMonth)
  250.             ChgDate% = Val(TheDate)
  251.             x% = SetFileDate(ThisFile$, ChgYear%, ChgMonth%, ChgDate%)
  252.             If x% = False Then
  253.                 Screen.MousePointer = 0
  254.                 MsgBox ThisFile$, 16, "Can Not Change Time"
  255.                 End If
  256.             ChangeCount% = ChangeCount% + 1
  257.             End If
  258.         Next i
  259.     Screen.MousePointer = 0
  260.     If ChangeCount% = 0 Then
  261.         MsgBox "No files selected to change!", 16, "File Change Error"
  262.         Exit Sub
  263.         Else
  264.         DoFileList
  265.         End If
  266.     Exit Sub
  267. BadDrive:
  268.     Screen.MousePointer = 0
  269.     MsgBox "Can NOT access drive!", 16, "Drive Error"
  270.     Exit Sub
  271. End Sub
  272. Sub CmdChgTime_Click ()
  273.     Screen.MousePointer = 11
  274.     ChangeCount% = 0
  275.     On Error GoTo BadDrive2
  276.     For i = 0 To FileList.ListCount - 1
  277.         If FileList.Selected(i) = True Then
  278.             ThisDir$ = CurDir$
  279.             pos% = InStr(FileList.List(i), Chr$(9))
  280.             ThisFile$ = Left$(FileList.List(i), pos% - 1)
  281.             ThisFile$ = AddSeparator(ThisDir$) + ThisFile$
  282.             ChgHours% = Val(TheHours)
  283.             ChgMinutes% = Val(TheMinutes)
  284.             x% = SetFileTime(ThisFile$, ChgHours%, ChgMinutes%)
  285.             If x% = False Then
  286.                 Screen.MousePointer = 0
  287.                 MsgBox ThisFile$, 16, "Can Not Change Time"
  288.                 End If
  289.             ChangeCount% = ChangeCount% + 1
  290.             End If
  291.         Next i
  292.     Screen.MousePointer = 0
  293.     If ChangeCount% = 0 Then
  294.         MsgBox "No files selected to change!", 16, "File Change Error"
  295.         Exit Sub
  296.         Else
  297.         DoFileList
  298.         End If
  299. Exit Sub
  300. BadDrive2:
  301.     Screen.MousePointer = 0
  302.     MsgBox "Can NOT access drive!", 16, "Drive Error"
  303.     Exit Sub
  304. End Sub
  305. Sub CmdDeselectAll_Click ()
  306.     Screen.MousePointer = 11
  307.     For i = 0 To FileList.ListCount - 1
  308.         FileList.Selected(i) = False
  309.         Next i
  310.     Screen.MousePointer = 0
  311. End Sub
  312. Sub CmdNewDate_Click ()
  313.     Screen.MousePointer = 11
  314.     CalSel.Show 1
  315.     Header = DateSerial(Val(TheYear), Val(TheMonth), Val(TheDate))
  316.     TheDateWord = Format$(Header, "d mmm yyyy")
  317.     LblDate.Caption = "Date to set:  " + TheDateWord
  318. End Sub
  319. Sub CmdNewTime_Click ()
  320. Dim TempHours As Integer
  321. Dim TempMinutes As Integer
  322. Dim TempMeridiem As Integer
  323.     Screen.MousePointer = 11
  324.     TimeChg.Show 1
  325.     TempHours = Val(TheHours)
  326.     If TempHours > 11 Then
  327.         TempHours = TempHours - 12
  328.         TempMeridiem = 1
  329.         Else
  330.         TempMeridiem = 0
  331.         End If
  332.     If TempHours = 0 Then TempHours = 12
  333.     TempMinutes = Val(TheMinutes)
  334.     TheTimeWord = Format$(TempHours, "##") + ":" + Format$(TempMinutes, "00")
  335.     If TempMeridiem = 1 Then
  336.         TheTimeWord = TheTimeWord + " pm"
  337.         Else
  338.         TheTimeWord = TheTimeWord + " am"
  339.         End If
  340.     LblTime.Caption = "Time to set:  " + TheTimeWord
  341. End Sub
  342. Sub CmdOkay_Click ()
  343.     Unload Me
  344. End Sub
  345. Sub CmdSelectAll_Click ()
  346.     Screen.MousePointer = 11
  347.     For i = 0 To FileList.ListCount - 1
  348.         FileList.Selected(i) = True
  349.         Next i
  350.     Screen.MousePointer = 0
  351. End Sub
  352. Sub Dir1_Change ()
  353.     Screen.MousePointer = 11
  354.     ChDir dir1.Path
  355.     LblFullPath.Caption = PathWord + LCase$(dir1.Path)
  356.     File1.Path = dir1.Path
  357.     DoFileList
  358.     Screen.MousePointer = 0
  359. End Sub
  360. Sub DoFileList ()
  361.     Screen.MousePointer = 11
  362.     On Error GoTo BadFileSpec
  363.     File1.Pattern = FileSpec
  364.     FileList.Clear
  365.     NbrFound% = File1.ListCount
  366.     If NbrFound% = 0 Then
  367.         FileWord$ = "No Matching Files Found"
  368.         ElseIf NbrFound% = 1 Then FileWord$ = "One Matching File Found"
  369.         Else
  370.         FileWord$ = Format$(NbrFound%, "###,##0") + " Matching Files Found"
  371.         End If
  372.     LblFileCount.Caption = FileWord$
  373.     If File1.ListCount = 0 Then
  374.         CmdChgDate.Enabled = False
  375.         CmdChgTime.Enabled = False
  376.         CmdSelectAll.Enabled = False
  377.         CmdDeselectAll.Enabled = False
  378.         ChgDateTime.Enabled = False
  379.         Screen.MousePointer = 0
  380.         Exit Sub
  381.         Else
  382.         CmdChgDate.Enabled = True
  383.         CmdChgTime.Enabled = True
  384.         CmdSelectAll.Enabled = True
  385.         CmdDeselectAll.Enabled = True
  386.         ChgDateTime.Enabled = True
  387.         For i = 0 To File1.ListCount - 1
  388.             TheFileName$ = File1.List(i)
  389.             FullPath$ = CurDir$
  390.             FullPath$ = AddSeparator(FullPath$) + TheFileName$
  391.             TimeStamp$ = FileDateTime(FullPath$)
  392.             TheFileDate$ = Format$(TimeStamp$, "dd mmm yyyy")
  393.             If Left$(TheFileDate$, 1) = "0" Then
  394.                 TheFileDate$ = " " + Right$(TheFileDate$, Len(TheFileDate$) - 1)
  395.                 End If
  396.             TheFileTime$ = Format$(TimeStamp$, "hh:mm am/pm")
  397.             If Left$(TheFileTime$, 1) = "0" Then
  398.                 TheFileTime$ = " " + Right$(TheFileTime$, Len(TheFileTime$) - 1)
  399.                 End If
  400.             TheFileSize$ = Format$(FileLen(FullPath$), "###,###,##0")
  401.             If Len(TheFileSize$) < 11 Then
  402.                 AddSpace$ = Space$(11 - Len(TheFileSize$))
  403.                 Else
  404.                 AddSpace$ = ""
  405.                 End If
  406.             TheFileSize$ = AddSpace$ + TheFileSize$
  407.             TheFileAttr% = GetAttr(FullPath$)
  408.             TheAttr$ = ""
  409.             If (TheFileAttr% And 32) <> 0 Then
  410.                 TheAttr$ = TheAttr$ + "A"
  411.                 Else
  412.                 TheAttr$ = TheAttr$ + "-"
  413.                 End If
  414.             If (TheFileAttr% And 4) <> 0 Then
  415.                 TheAttr$ = TheAttr$ + "S"
  416.                 Else
  417.                 TheAttr$ = TheAttr$ + "-"
  418.                 End If
  419.             If (TheFileAttr% And 2) <> 0 Then
  420.                 TheAttr$ = TheAttr$ + "H"
  421.                 Else
  422.                 TheAttr$ = TheAttr$ + "-"
  423.                 End If
  424.             If (TheFileAttr% And 1) <> 0 Then
  425.                 TheAttr$ = TheAttr$ + "R"
  426.                 Else
  427.                 TheAttr$ = TheAttr$ + "-"
  428.                 End If
  429.             FileList.AddItem TheFileName$ + Chr$(9) + TheFileDate$ + Chr$(9) + TheFileTime$ + Chr$(9) + TheAttr$ + Chr$(9) + TheFileSize$
  430.             Next i
  431.         End If
  432.     Screen.MousePointer = 0
  433.     Exit Sub
  434. BadFileSpec:
  435.     Screen.MousePointer = 0
  436.     Beep
  437.     MsgBox "Invalid File Specification!", 16, "Data Entry Error"
  438.     Text1.SetFocus
  439.     Exit Sub
  440. End Sub
  441. Sub Drive1_Change ()
  442.     On Error GoTo SelDrvBad
  443.     Screen.MousePointer = 11
  444.     ChDrive Drive1.Drive
  445.     dir1.Path = Drive1.Drive
  446.     Screen.MousePointer = 0
  447.     Exit Sub
  448. SelDrvBad:
  449.     Screen.MousePointer = 0
  450.     msg$ = "Drive Error " + UCase$(Left$(Drive1.Drive, 1)) + ":"
  451.     response = MsgBox("Can NOT Access Drive!", 21, msg$)
  452.     If response = 4 Then
  453.         Screen.MousePointer = 11
  454.         Resume 0
  455.         End If
  456.     WinRoot
  457.     Exit Sub
  458. End Sub
  459. Sub Form_Load ()
  460.     FormCenterScreen Me
  461.     PathWord = "Full Path = "
  462.     TheDateWord = Format$(Now, "d mmm yyyy")
  463.     TheMonth = Format$(Now, "m")
  464.     TheDate = Format$(Now, "d")
  465.     TheYear = Format$(Now, "yyyy")
  466.     LblDate.Caption = "Date to set:  " + TheDateWord
  467.     TheTimeWord = Format$(Now, "h:mm am/pm")
  468.     TheHours = Format$(Now, "h")
  469.     TheMinutes = Format$(Now, "n")
  470.     LblTime.Caption = "Time to set:  " + TheTimeWord
  471.     On Error GoTo BadDrive3
  472.     LblFullPath.Caption = PathWord + LCase$(CurDir$)
  473.     ListHscroll FileList, 40
  474.     ReDim tabsets%(4)
  475.     tabsets%(0) = 0
  476.     tabsets%(1) = 16 * 4
  477.     tabsets%(2) = 30 * 4
  478.     tabsets%(3) = 42 * 4
  479.     tabsets%(4) = 44 * 4
  480.     dummy% = OutMessage(FileList.hWnd, 1043, 5, tabsets%(0))
  481.     FileSpec = "*.*"
  482.     Text1.Text = FileSpec
  483.     DoFileList
  484.     Screen.MousePointer = 0
  485.     Exit Sub
  486. BadDrive3:
  487.     WinRoot
  488.     Resume Next
  489. End Sub
  490. Sub Form_Paint ()
  491.     DoForm3D Me, sunken, 3, 0
  492.     DoForm3D Me, raised, 1, 3
  493.     DoControl3D LblFullPath, sunken, 1
  494.     DoControl3D LblFileCount, sunken, 1
  495.     DoControl3D LblDate, sunken, 1
  496.     DoControl3D LblTime, sunken, 1
  497. End Sub
  498. Sub Text1_GotFocus ()
  499.     Text1.SelStart = 0
  500.     Text1.SelLength = Len(Text1.Text)
  501. End Sub
  502. Sub Text1_KeyPress (KeyAscii As Integer)
  503.     char = Chr(KeyAscii)
  504.     KeyAscii = Asc(UCase(char))
  505.     If char = "\" Then KeyAscii = 0
  506.     If char = Chr$(34) Then KeyAscii = 0
  507.     If char = Chr$(32) Then KeyAscii = 0
  508.     If char = ":" Then KeyAscii = 0
  509.     If char = Chr$(13) Then
  510.         KeyAscii = 0
  511.         SendKeys "{TAB}"
  512.         Exit Sub
  513.         End If
  514. End Sub
  515. Sub Text1_LostFocus ()
  516.     FileSpec = Text1.Text
  517.     DoFileList
  518. End Sub
  519. Sub WinRoot ()
  520.     Screen.MousePointer = 11
  521.     WinDir$ = Left$(GetWinDir(), 3)
  522.     Drive1.Drive = WinDir$
  523.     ChDrive WinDir$
  524.     dir1.Path = CurDir$
  525.     LblFullPath.Caption = PathWord + LCase$(dir1.Path)
  526.     Screen.MousePointer = 0
  527. End Sub
  528.